/* fafamtj.p - FIXED ASSETS MAINTENANCE - Units of Production               */
/* Copyright 1986 QAD Inc. All rights reserved.                               */
/* $Id:: fafamtj.p 59128 2015-08-21 10:49:10Z nsc                          $: */
/* REVISION: 9.1      LAST MODIFIED: 10/26/99   BY: *N021* Pat Pigatti      */
/* REVISION: 9.1      LAST MODIFIED: 03/24/00   BY: *N08T* Annasaheb Rahane */
/* REVISION: 9.1      LAST MODIFIED: 05/17/00   BY: *M0LJ* Vihang Talwalkar */
/* REVISION: 9.1      LAST MODIFIED: 07/28/00   BY: *N0BX* Arul Victoria    */
/* REVISION: 9.1      LAST MODIFIED: 08/14/00   BY: *N0L0* Jacolyn Neder    */
/* Revision: 1.14.1.11  BY: Paul Donnelly(SB) DATE: 06/26/03 ECO: *Q00C* */
/* Revision: 1.14.1.12  BY: Gaurav Kerkar     DATE: 07/20/04 ECO: *P2B8* */
/* Revision: 1.14.1.13  BY: Vandna Rohira     DATE: 12/17/04 ECO: *P2Z5*  */
/*-Revision end-------------------------------------------------------------*/
/******************************************************************************/
/* All patch markers and commented out code have been removed from the source */
/* code below. For all future modifications to this file, any code which is   */
/* no longer required should be deleted and no in-line patch markers should   */
/* be added.  The ECO marker should only be included in the Revision History. */
/******************************************************************************/

{us/bbi/mfdeclre.i}
{us/bbi/gplabel.i} /* EXTERNAL LABEL INCLUDE */

/* --------------------  Define Query  ------------------- */
define query q_fab_det for
   fab_det
   scrolling.

/* -----------------  Standard Variables  ---------------- */
define variable p-status as character no-undo.
define variable perform-status as character format "x(25)"
   initial "first" no-undo.
define variable p-skip-update like mfc_logical no-undo.
define variable l-rowid as rowid no-undo.
define variable l-delete-it like mfc_logical no-undo.
define variable l-del-rowid as rowid no-undo.
define variable l-top-rowid as rowid no-undo.
define variable lines as integer initial 10 no-undo.
define variable l-found like mfc_logical no-undo.
define variable pos as integer no-undo.
define variable l-first like mfc_logical no-undo.
define variable l-error like mfc_logical no-undo.
define variable l-title as character no-undo.

/* ------------------  Button Variables  ----------------- */
define button b-update label "Update".
define button b-actual label "Actual".
define button b-end label "End".

/* -------------  Standard Widget Variables  ------------- */
define variable l-focus as widget-handle no-undo.
define variable w-frame as widget-handle no-undo.

/* ------------------  Screen Variables  ----------------- */
define shared variable l-fa-id as character format "x(12)" no-undo.
define shared variable l-fabk-id as character format "x(4)" no-undo.
define variable l-up-consumed as integer format ">,>>>,>>>,>>9" no-undo.
define variable l-err-nbr as integer format ">>>9" initial 0 no-undo.
define variable l-recalc like mfc_logical no-undo.
define variable l-acc-dep as decimal format "->>,>>>,>>>,>>9.999" no-undo.
define variable fab_amt_fmt as character format "x(30)" no-undo. 
define variable l-per as character format "x(6)" no-undo.
define variable totCost like fab_amt no-undo.
define variable salvAmt like fab_salvamt no-undo.
define variable l-resrv like fab_resrv no-undo.

define variable fab_upcost_fmt  as character format "x(20)"  no-undo.
define variable fab_salvamt_fmt as character format "x(20)"  no-undo.
define variable l-book-curr     as character                 no-undo.
define variable rndmthd         like rnd_rnd_mthd            no-undo. 
define variable mc-error-number like msg_nbr                 no-undo.
/* ------------------  Frame Definition  ----------------- */
define frame f-button
   b-update at 1
   b-actual at 10
   b-end at 19
with no-box overlay three-d side-labels width 28.

/* CLEAR FRAME REGISTRATION TO TRANSLATE THE FRAME EVERYTIME*/
clearFrameRegistration(frame f-button:handle).

/* SET EXTERNAL LABELS */
setFrameLabels(frame f-button:handle).

assign
   l-focus = b-update:handle in frame f-button
   b-update:width = 8
   b-update:private-data = "update"
   b-actual:width = 8
   b-actual:private-data = "actual"
   b-end:width = 8
   b-end:private-data = "end".

define frame f-1
   skip(.4)
   fab_fa_id colon 17
   fab_uplife colon 50
   skip
   fab_fabk_id colon 17
   fab_upper colon 50
   skip
   fab_um colon 17
   l-per label "Eff Period" colon 50
   skip
   fab_famtr_id colon 17
   fab_amt colon 50
   skip
   fab_upcost colon 17
   fab_salvamt colon 50
with three-d overlay side-labels width 80.

/* CLEAR FRAME REGISTRATION TO TRANSLATE THE FRAME EVERYTIME*/
clearFrameRegistration(frame f-1:handle).

/* SET EXTERNAL LABELS */
setFrameLabels(frame f-1:handle).

run ip-framesetup.

w-frame = frame f-1:handle.
{us/bbi/gprun.i ""fafmtut.p""
   "(w-frame)"}

/* ---------------  Pre Processing Include  -------------- */
{us/gp/gprunpdf.i "fapl" "p"}  /* VARIABLES FOR FA PROCEDURES */

for first fa_mstr  
   where fa_mstr.fa_domain = global_domain 
     and fa_id = l-fa-id 
no-lock:
end.  /* FOR FIRST fa_mstr */
for last fab_det  
   where fab_det.fab_domain = global_domain 
     and fab_fa_id =l-fa-id 
     and fab_fabk_id = l-fabk-id 
no-lock:
   l-resrv = fab_resrv.
end.  /* FOR LAST fab_det */
for last fabd_det no-lock  
   where fabd_det.fabd_domain = global_domain
     and fabd_fa_id = l-fa-id 
     and fabd_fabk_id = l-fabk-id 
     and fabd_post = yes:
end.  /* FOR LAST fabd_det no-lock */

l-up-consumed = if available fabd_det
                then
                   fabd_accup
                else
                   0.

/* SET CURRENCY DEPENDENT ROUNDING FORMATS */
for first gl_ctrl 
   where gl_ctrl.gl_domain = global_domain
no-lock:
end.  
 
for first fabk_mstr 
   where fabk_domain = global_domain 
     and fabk_id     = l-fabk-id 
   no-lock, 
first cu_mstr of fabk_mstr no-lock: 
   l-book-curr = cu_curr. 
end.
/* GET ROUNDING METHOD FROM CURRENCY MASTER */
{us/gp/gprunp.i "mcpl" "p" "mc-get-rnd-mthd"
   "(input  l-book-curr,
    output rndmthd,
    output mc-error-number)"}
if mc-error-number <> 0
then do:
   {us/bbi/pxmsg.i &MSGNUM=mc-error-number &ERRORLEVEL=2}
   leave.
end. /* IF mc-error-number <> 0 */
find first rnd_mstr where rnd_rnd_mthd = rndmthd 
   no-lock no-error.
if not available rnd_mstr
then do:
   /* ROUND METHOD RECORD NOT FOUND */
   {us/bbi/pxmsg.i &MSGNUM=863 &ERRORLEVEL=4}
   leave.
end.    
   
fab_amt_fmt = fab_det.fab_amt:format.
{us/bbi/gprun.i ""gpcurfmt.p""
   "(input-output fab_amt_fmt,
    input rndmthd)"}
fab_det.fab_amt:format in frame f-1 = fab_amt_fmt.
  
fab_upcost_fmt = fab_det.fab_amt:format.
{us/bbi/gprun.i ""gpcurfmt.p""
   "(input-output fab_upcost_fmt,
    input rndmthd)"}
fab_det.fab_upcost:format in frame f-1 = fab_upcost_fmt. 

fab_salvamt_fmt = fab_det.fab_amt:format.
{us/bbi/gprun.i ""gpcurfmt.p""
   "(input-output fab_salvamt_fmt,
    input rndmthd)"}
fab_det.fab_salvamt:format in frame f-1 = fab_salvamt_fmt.  
    
/* -------------  END Pre Processing Include  ------------ */

open query q_fab_det for each fab_det
   where fab_det.fab_domain = global_domain and  fab_fa_id = l-fa-id
   and
   fab_fabk_id = l-fabk-id and
   fab_resrv = l-resrv no-lock.

get first q_fab_det no-lock.

main-loop:
do while perform-status <> "end" on error undo:
   /* -------------  Top Of Main-Loop Include  ------------ */
   if perform-status = "first" or
      perform-status = "end"
   then do:
      assign
         p-status = if perform-status = "first"
         then
            "first-one"
         else
            "end".

      if available fab_det
      then
         {us/bbi/gprun.i ""fafamtn.p"" "(input p-status,
            buffer fab_det)"}
   end.  /* IF perform-status = "first" OR ... */
   /* -----------  END Top Of Main-Loop Include  ---------- */

   run ip-query
      (input-output perform-status,
       input-output l-rowid).

   /* ----------------------  Actual  --------------------- */
   if perform-status = "actual"
   then do:
      p-status = "display".
      if session:display-type = "gui"
      then
         assign
            fab_fa_id:bgcolor = 8
            fab_fa_id:fgcolor = 0.
      else
         color display normal fab_fa_id
         with frame f-1.
      if available fab_det
      then
         {us/bbi/gprun.i ""fafamtn.p""
            "(input p-status,
              buffer fab_det)"}
      perform-status = "first".
      run ip-displayedits.
   end.  /* IF perform-status = "actual"  */
   /* --------------------  End Actual  ------------------- */

   /* ----------------------  Display  ---------------------- */
   run ip-predisplay.

   if (perform-status = "update" or
       perform-status = "add")
   then do:
      run ip-prompt.
      if perform-status = "undo"
      then do:
         perform-status = "first".
         next main-loop.
      end.  /* IF perform-status = "undo"  */
      run ip-displayedits.
   end.  /* IF (perform-status = "update" OR ... */

   /* -----------------------  End  ----------------------- */
   if perform-status = "end"
   then do:
      hide frame f-1 no-pause.
      delete PROCEDURE this-procedure no-error.
      leave.
   end.  /* IF perform-status = "end"  */

   /* ----------------  Selection Buttons  ---------------- */
   if perform-status <> "first"
   then
      run ip-button
         (input-output perform-status).

   /* -------------  After Strip Menu Include  ------------ */
   if perform-status = "update"
   then do:
      if can-find(fa_mstr where fa_mstr.fa_domain = global_domain and
         fa_id = fab_fa_id and
         fa_disp_dt <> ?)
      then do:
         /* NO MODIFICATIONS ALLOWED - ASSET HAS BEEN RETIRED */
         {us/bbi/pxmsg.i &MSGNUM=3211 &ERRORLEVEL=4}
         next main-loop.
      end.  /* IF CAN-FIND(fa_mstr */
      for last fabd_det no-lock where 
         fabd_det.fabd_domain = global_domain and
         fabd_fa_id = fab_fa_id and
         fabd_fabk_id = fab_fabk_id:
         if fab_uplife = fabd_accup
         then do:
            /* ASSET IS FULLY CONSUMED */
            {us/bbi/pxmsg.i &MSGNUM=2991 &ERRORLEVEL=4}
            next main-loop.
         end.  /* IF fab_uplife = fabd_accup  */
      end.  /* FOR LAST fabd_det */
   end. /* IF perform-status = "update"  */
   /* -----------  END After Strip Menu Include  ---------- */

end.  /* MAIN-LOOP */
p-status = "end".
{us/bbi/gprun.i ""fafamtn.p"" 
   "(input p-status,
     buffer fab_det)"}

/* -------------  Add / Update / Field Edits  ------------ */
PROCEDURE ip-prompt:
   if perform-status = "add"
   then
      clear frame f-1 all no-pause.
   l-first = yes.
   CASE perform-status:
      when ("add")
      then
         /* ADDING NEW RECORD */
         {us/bbi/pxmsg.i &MSGNUM=1 &ERRORLEVEL=1}
      when ("update")
      then
         /* MODIFYING EXISTING RECORD */
         {us/bbi/pxmsg.i &MSGNUM=10 &ERRORLEVEL=1}
      otherwise
         hide message no-pause.
   END CASE.
   ststatus = stline[3].
   status input ststatus.

   /* BEFORE-ADD-EDIT */
   if l-first and
      perform-status = "add"
   then do:
      assign
         fab_det.fab_uplife:screen-value = string(fab_det.fab_uplife)
         fab_det.fab_upper:screen-value = string(fab_det.fab_upper)
         fab_det.fab_amt:screen-value = string(fab_det.fab_amt).
   end.  /* IF l-first AND */
   /* BEFORE-ADD-EDIT */

   /* BEFORE-UPDATE-EDIT */
   if l-first and
      perform-status = "update"
   then do:
      if available fab_det
      then
         for last fabd_det no-lock where 
            fabd_det.fabd_domain = global_domain and
            fabd_fa_id = fab_fa_id and
            fabd_fabk_id = fab_fabk_id and
            fabd_post = yes:
         assign
            l-per = fabd_yrper.
         end.  /* FOR LAST fabd_det */

   end.  /* IF l-first AND ... */
   /* BEFORE-UPDATE-EDIT */

   prompt-for-it:
   repeat:
      assign
         l-first = no.
      repeat:
         prompt-for
            fab_det.fab_um
            fab_det.fab_famtr_id
            fab_det.fab_uplife
            fab_det.fab_upper
            l-per
         with frame f-1.

         assign
            l-per.
         /* FIELD EDIT FOR fab_famtr_id */
         l-error = no.
         if fab_famtr_id:screen-value <> "" and
            not can-find(famtr_mstr where 
            famtr_mstr.famtr_domain = global_domain and
            famtr_id = fab_famtr_id:screen-value)
         then do:
            l-error = yes.
            /* INVALID METER ID */
            {us/bbi/pxmsg.i &MSGNUM=3263 &ERRORLEVEL=3}
         end.  /* IF fab_famtr_id:screen-value <> "" AND ... */
         if l-error
         then do:
            next-prompt fab_famtr_id with frame f-1.
            next.
         end.  /* IF l-error  */
         /* END FIELD EDIT FOR fab_famtr_id */

         if input frame f-1 fab_uplife = 0
         then do:
            /* ZERO NOT ALLOWED */
            {us/bbi/pxmsg.i &MSGNUM=317 &ERRORLEVEL=3}
            next-prompt fab_uplife with frame f-1.
            next.
         end.  /* IF INPUT FRAME f-1 fab_uplife = 0  */
         /* FIELD EDIT FOR fab_uplife */
         l-error = no.
         if l-up-consumed > integer(fab_uplife:screen-value)
         then do:
            /* TOTAL UNITS LESS THAN UNITS CONSUMED */
            {us/bbi/pxmsg.i &MSGNUM=3236 &ERRORLEVEL=3}
            l-error = yes.
         end.  /* IF l-up-consumed > integer(fab_uplife:screen-value)  */
         if l-error
         then do:
            next-prompt fab_uplife with frame f-1.
            next.
         end.  /* IF l-error  */
         /* END FIELD EDIT FOR fab_uplife */

         if input frame f-1 fab_upper = 0
         then do:
            /* ZERO NOT ALLOWED */
            {us/bbi/pxmsg.i &MSGNUM=317 &ERRORLEVEL=3}
            next-prompt fab_upper with frame f-1.
            next.
         end.  /* IF INPUT FRAME f-1 fab_upper = 0  */
         /* FIELD EDIT FOR fab_upper */
         l-error = no.
         if integer(fab_upper:screen-value) >
            (integer(fab_uplife:screen-value) - l-up-consumed)
         then do:
            /* UNITS PER PERIOD GREATER THAN REMAINING UNITS */
            {us/bbi/pxmsg.i &MSGNUM=3238 &ERRORLEVEL=3}
            l-error = yes.
         end.  /* IF integer(fab_upper:screen-value) > */
         if l-error
         then do:
            next-prompt fab_upper with frame f-1.
            next.
         end.  /* IF l-error  */
         /* END FIELD EDIT FOR fab_upper */

         /* FIELD EDIT FOR l-per */
         l-error = no.
         if frame f-1 fab_uplife entered or
            frame f-1 fab_upper entered
         then do:
            if can-find(first fauop_det where 
               fauop_det.fauop_domain = global_domain and
               fauop_fa_id = fab_fa_id and
               fauop_fabk_id = fab_fabk_id) and
               not can-find(first fauop_det  where
               fauop_det.fauop_domain = global_domain and
               fauop_fa_id = fab_fa_id and
               fauop_fabk_id = fab_fabk_id and
               fauop_yrper = l-per)
            then do:
               {us/bbi/pxmsg.i &MSGNUM=3237 &ERRORLEVEL=3} /* PERIOD DOES NOT EXIST */
               l-error = yes.
            end.  /* IF CAN-FIND(first fauop_det */
         end.  /* IF FRAME f-1 fab_uplife ENTERED OR ... */
         if l-error
          then do:
            next-prompt l-per with frame f-1.
            next.
         end.  /* IF l-error  */
         /* END FIELD EDIT FOR l-per */

         leave.
      end.  /* REPEAT */
      if keyfunction(lastkey) = "end-error"
      then do:
         perform-status = "undo".
         return no-apply.
      end.  /* IF keyfunction(lastkey) = "end-error"  */
      leave.
   end. /* PROMPT-FOR-IT */
   if keyfunction(lastkey) = "end-error"
   then do:
      if perform-status = "add"
      then do:
         /* RECORD NOT ADDED */
         {us/bbi/pxmsg.i &MSGNUM=1304 &ERRORLEVEL=1}
      end.  /* IF perform-status = "add"  */
      perform-status = "first".
      clear frame f-1.
      get current q_fab_det no-lock.
      run ip-displayedits.
      return.
   end.  /* IF keyfunction(lastkey) = "end-error"  */
   run ip-lock
      (input-output perform-status).
END PROCEDURE. /* ip-prompt */

/* -----------------------  Locking  ----------------------- */
PROCEDURE ip-lock:
   define input-output parameter perform-status as character no-undo.

   if perform-status = "add" or
      perform-status = "update" or
      perform-status = "delete"
   then
      ip-lock:
      do transaction on error undo:
         assign
            pos = 0
            l-delete-it = yes.

         if available fab_det
         then
            get current q_fab_det no-lock.
         if available fab_det and
         current-changed fab_det
         then do:
            l-delete-it = yes.
            /* RECORD HAS BEEN MODIFIED SINCED YOU EDITED IT SAVE ANYWAY */
            {us/bbi/pxmsg.i &MSGNUM=2042 &ERRORLEVEL=1 &CONFIRM=l-delete-it}
            if l-delete-it = no
            then do:
               hide message no-pause.
               run ip-displayedits.
               return.
            end.  /* IF l-delete-it = no  */
            hide message no-pause.
         end.  /* IF AVAILABLE fab_det AND ... */
         if available fab_det
         then
            tran-lock:
            do while perform-status <> "":
               get current q_fab_det exclusive-lock no-wait.
               if locked fab_det
               then do:
                  if pos < 3
                  then do:
                     pos = pos + 1.
                     pause 1 no-message.
                     next tran-lock.
                  end.  /* IF pos < 3  */
                  perform-status = "error".
               end.  /* IF LOCKED fab_det  */
               leave.
            end. /*WHILE*/

         if (perform-status = "update" or
         p-status = "update") and /* if locked fab_det  */
         l-delete-it = yes
         then
            run ip-update
               (input-output perform-status).
         if perform-status = "delete"
         then
            run ip-delete
               (input-output perform-status).

         /* --------------  /* LOCKED-EDITS */  ------------- */
         if l-error = yes
         then
            undo ip-lock, leave.
         /* ------------  END /* LOCKED-EDITS */  ----------- */

         if available fab_det
         then
            get current q_fab_det no-lock.
      end.  /* IP-LOCK */
      if perform-status = "add"
      then
         run ip-add
            (input-output perform-status).
END PROCEDURE. /* ip-lock */

PROCEDURE ip-update:
   define input-output parameter perform-status as character no-undo.

   if p-status = "update"
   then
      p-status = "".
   run ip-assign
      (input-output perform-status).
   perform-status = "open".
   run ip-query
      (input-output perform-status,
       input-output l-rowid).
END PROCEDURE. /* ip-update */

PROCEDURE ip-add:
   define input-output parameter perform-status as character no-undo.

   create fab_det.
   fab_det.fab_domain = global_domain.
   run ip-assign
      (input-output perform-status).
   perform-status = "open".
   run ip-query
      (input-output perform-status,
       input-output l-rowid).
   perform-status = "first".
   return.
END PROCEDURE. /* ip-add */

PROCEDURE ip-delete:
   define input-output parameter perform-status as character no-undo.

   l-delete-it = no.
   /* PLEASE CONFIRM DELETE */
   {us/bbi/pxmsg.i &MSGNUM=11 &ERRORLEVEL=1 &CONFIRM=l-delete-it}
   CASE l-delete-it:
      when yes
      then do:
         hide message no-pause.
         delete fab_det.
         clear frame f-1 no-pause.
         get next q_fab_det no-lock.
         if available fab_det
         then do:
            assign
               perform-status = "first"
               l-rowid = rowid(fab_det).
         end.  /* IF AVAILABLE fab_det  */
         else do:
            get prev q_fab_det no-lock.
            if available fab_det
            then do:
               assign
                  perform-status = "first"
                  l-rowid = rowid(fab_det).
            end.  /* IF AVAILABLE fab_det  */
            else
               assign
                  perform-status = "first"
                  l-rowid = rowid(fab_det).
         end.  /* IF NOT AVAILABLE fab_det  */
         /* RECORD DELETED */
         {us/bbi/pxmsg.i &MSGNUM=22 &ERRORLEVEL=1}
         return.
      end. /* WHEN YES */
      otherwise
         run ip-displayedits.
   END CASE.
END PROCEDURE. /* ip-delete */

PROCEDURE ip-assign:
   define input-output parameter perform-status as character no-undo.
   do with frame f-1:
      assign
         fab_det.fab_uplife
         fab_det.fab_upper
         fab_det.fab_um
         fab_det.fab_famtr_id
         l-rowid = rowid(fab_det).

      /* --------  /* AFTER-ASSIGN-AUDIT-INCLUDE */  ------- */
      if (frame f-1 fab_det.fab_uplife entered or
         frame f-1 fab_det.fab_upper entered) and
         not l-error
      then do:
         /* CALCULATE FORCAST */
         {us/bbi/gprun.i ""faupbl.p""
            "(buffer fab_det,
              l-per)"}
         /* RESET COST AND DEPRECIATION EXPENSE */
         {us/bbi/gprun.i ""faupblc.p""
            "(buffer fab_det,
              l-per,
              output l-err-nbr)"}
         if l-err-nbr > 0
         then do:
            {us/bbi/pxmsg.i &MSGNUM=l-err-nbr &ERRORLEVEL=4}
            l-error = yes.
         end.  /* IF l-err-nbr > 0  */
      end.  /* IF (frame f-1 fab_det.fab_uplife entered OR ... */

      if l-recalc = yes and
         l-error = no
      then do:
         assign
            p-status = "first-one".
         {us/bbi/gprun.i ""fafamtn.p""
            "(input p-status,
              buffer fab_det)"}
      end.  /* IF l-recalc = yes AND ... */

      /* ------  END /* AFTER-ASSIGN-AUDIT-INCLUDE */  ----- */

   end.  /* DO WITH FRAME f-1: */
END PROCEDURE. /* ip-assign */

PROCEDURE ip-predisplay:
   if perform-status = "" and
      available fab_det
   then
      display-loop:
      do:
         clear frame f-1 all no-pause.
         run ip-displayedits.
         run ip-postdisplay.
      end.  /* DISPLAY-LOOP */
END PROCEDURE. /* ip-predisplay */

PROCEDURE ip-displayedits:
   if available fab_det
   then do:
      {us/gp/gprunp.i "fapl" "p" "fa-get-cost"
         "(input  fab_fa_id,
           input  fab_fabk_id,
           output totCost)"}
      {us/gp/gprunp.i "fapl" "p" "fa-get-salvage"
         "(input  fab_fa_id,
           input  fab_fabk_id,
           output salvAmt)"}
      run ip-display.
   end.  /* IF AVAILABLE fab_det  */
END PROCEDURE. /* ip-displayedits */

PROCEDURE ip-display:
   display
      fab_det.fab_fa_id
      fab_det.fab_fabk_id
      fab_det.fab_uplife
      fab_det.fab_upper
      fab_det.fab_um
      totCost @ fab_amt
      salvAmt @ fab_salvamt
      l-per
      fab_det.fab_famtr_id
      fab_det.fab_upcost
   with frame f-1.
END PROCEDURE. /* ip-display */

PROCEDURE ip-postdisplay:
   color display message fab_fa_id
   with frame f-1.

END PROCEDURE. /* ip-postdisplay */

PROCEDURE ip-query:
   define input-output parameter perform-status as character
      no-undo.
   define input-output parameter l-rowid as rowid no-undo.

   if perform-status = "first"
   then do:
      if l-rowid <> ?
      then do:
         reposition q_fab_det to rowid l-rowid no-error.
         get next q_fab_det no-lock.
      end.  /* IF l-rowid <> ?  */
      if not available fab_det
      then
         get first q_fab_det no-lock.
      if available fab_det
      then
         assign
            perform-status = ""
            l-rowid = rowid(fab_det).
      else do:
         assign
            perform-status = ""
            l-rowid = ?.
         assign
            frame f-1:visible = true.
         return.
      end.  /* IF NOT AVAILABLE fab_det  */
   end.  /* IF perform-status = "first"  */
   if perform-status = "open"
   then do:
      open query q_fab_det for each fab_det
         where fab_det.fab_domain = global_domain and  
         fab_fa_id = l-fa-id and
         fab_fabk_id = l-fabk-id and
         fab_resrv = l-resrv no-lock.

      reposition q_fab_det to rowid l-rowid no-error.
      get next q_fab_det no-lock.
      if available fab_det
      then
         assign
            perform-status = ""
            l-rowid = rowid(fab_det).
      else do:
         get first q_fab_det no-lock.
         if not available fab_det
         then do:
            assign
               perform-status = ""
               frame f-1:visible = true.
            return.
         end.  /* IF NOT AVAILABLE fab_det  */
         else
            assign
               perform-status = ""
               l-rowid = rowid(fab_det).
      end.  /* IF NOT AVAILABLE fab_det  */
   end.  /* IF perform-status = "open"  */
   if perform-status = "next"
   then do:
      get next q_fab_det no-lock.
      if available fab_det
      then do:
         assign
            l-rowid = rowid(fab_det)
            perform-status = "first".
         hide message no-pause.
         run ip-displayedits.
      end.  /* IF AVAILABLE fab_det  */
      else do:
         perform-status = "".
         /* END OF FILE */
         {us/bbi/pxmsg.i &MSGNUM=20 &ERRORLEVEL=2}
         get prev q_fab_det no-lock.
      end.  /* IF NOT AVAILABLE fab_det  */
   end.  /* IF perform-status = "next"  */
   if perform-status = "prev"
   then do:
      get prev q_fab_det no-lock.
      if available fab_det
      then do:
         assign
            l-rowid = rowid(fab_det)
            perform-status = "first".
         hide message no-pause.
         run ip-displayedits.
      end.  /* IF AVAILABLE fab_det  */
      else do:
         perform-status = "".
         /* BEGINNING OF FILE */
         {us/bbi/pxmsg.i &MSGNUM=21 &ERRORLEVEL=2}
         get next q_fab_det no-lock.
      end.  /* IF NOT AVAILABLE fab_det  */
   end.  /* IF perform-status = "prev"  */
   if perform-status = "update" or
      perform-status = "delete"
   then do:
      get current q_fab_det no-lock.
      if not available fab_det
      then do:
         hide message no-pause.
         /* RECORD NOT FOUND */
         {us/bbi/pxmsg.i &MSGNUM=1310 &ERRORLEVEL=3}
         perform-status = "".
      end.  /* IF NOT AVAILABLE fab_det  */
   end.  /* IF perform-status = "update" OR ... */
END PROCEDURE. /* ip-query */

PROCEDURE ip-framesetup:

   if session:display-type = "gui"
   then
      frame f-1:row = 4.75.
   else
      frame f-1:row = 4.

   assign
      frame f-1:box = true
      frame f-1:centered = true
      frame f-1:title = (getFrameTitle("UNITS_OF_PRODUCTION",28))
      frame f-button:centered = true
      frame f-button:row = 20.
END PROCEDURE. /* ip-framesetup */

PROCEDURE ip-button:
   define input-output parameter perform-status as character
      format "x(25)" no-undo.

   if not batchrun
   then do:

      enable all with frame f-button.
      ststatus = stline[1].
      status input ststatus.

      on choose of b-update
      do:
         assign
            perform-status = self:private-data
            l-focus = self:handle.
         hide frame f-button no-pause.
      end.  /* ON CHOOSE OF b-update */
      on choose of b-actual
      do:
         assign
            perform-status = self:private-data
            l-focus = self:handle
            l-title = current-window:title
                    + " - "
                    + self:label.
         hide frame f-button no-pause.
      end.  /* ON CHOOSE OF b-actual */
      on choose of b-end
      do:
         assign
            perform-status = self:private-data
            l-focus = self:handle.
         hide frame f-1 no-pause.
         hide frame f-button no-pause.
      end.  /* ON CHOOSE OF b-end */
      on cursor-up, f9 anywhere
      do:
         assign
            perform-status = "prev"
            l-focus = focus:handle.
         apply "go" to frame f-button.
      end.  /* ON CURSOR-UP, F9 ANYWHERE */
      on cursor-down, f10 anywhere
      do:
         assign
            perform-status = "next"
            l-focus = focus:handle.
         apply "go" to frame f-button.
      end.  /* ON CURSOR-DOWN, F10 ANYWHERE */
      on cursor-right anywhere
      do:
         l-focus = self:handle.
         apply "tab" to l-focus.
      end.  /* ON CURSOR-RIGHT ANYWHERE */
      on cursor-left anywhere
      do:
         l-focus = self:handle.
         if session:display-type = "gui"
         then
            apply "shift-tab" to l-focus.
         else
            apply "ctrl-u" to l-focus.
      end.  /* ON CURSOR-LEFT ANYWHERE */
      on esc anywhere
      do:
         if session:display-type = "gui"
         then
            apply "choose" to b-end in frame f-button.
      end.  /* ON ESC ANYWHERE */
      on end-error anywhere
         apply "choose" to b-end in frame f-button.
      on window-close of current-window
         apply "choose" to b-end in frame f-button.
      on go anywhere
      do:
         if (lastkey = keycode("cursor-down") or
             lastkey = keycode("cursor-up") or
             lastkey = keycode("f9") or
             lastkey = keycode("f10"))
         then
            return.
         else
         l-focus = focus:handle.
         apply "choose" to l-focus.
      end.  /* ON GO ANYWHERE */

      wait-for
         go of frame f-button or
         window-close of current-window or
         choose of
         b-update,
         b-actual,
         b-end
         focus
         l-focus.

   end. /* IF NOT BATCHRUN */
   else
      set perform-status.

   hide message no-pause.
END PROCEDURE. /* ip-button */
